home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 5 / Skunkware 5.iso / lib / emacs / lisp / wais.el
Encoding:
Text File  |  1995-07-26  |  73.5 KB  |  2,408 lines
  1. ;;; A GNU Emacs interface to WAIS
  2. ;;;
  3. ;;;  Jonny Goldman <jonathan@think.com>
  4. ;;;
  5. ;;; liberally ripped off from various sources, and heavily influenced
  6. ;;; by wais-interface.el from Brewster and Bonnie.
  7. ;;;
  8. ;;; $Header: /usr/local/ls6/src+data/src/freeWAIS-sf/ui/RCS/wais.el.raw,v 1.1 1994/08/05 07:19:54 pfeifer Exp $
  9. ;;; include the following in your .emacs file (without semicolons):
  10. ;;; (autoload 'wais "wais"
  11. ;;;       "Do something useful for WAIS" t)
  12. ;;; (autoload 'wais-select-question "wais"
  13. ;;;       "Select a question for WAIS" t)
  14. ;;; (autoload 'wais-create-question "wais"
  15. ;;;       "Create a new question for WAIS" t)
  16.  
  17. (provide 'wais)
  18. (require 'cl)
  19.  
  20. ;;; These are important variables.  Set them appropriately.
  21.  
  22. (defvar *wais-top-directory* /usr/skunk)
  23. (defvar waisq-program (concat *wais-top-directory* "bin/waisq")
  24.   "Location of the waisq executable. 
  25.    This comes in the bin directory of the wais release") 
  26. (defvar waisindex-program (concat *wais-top-directory* "bin/waisindex")
  27.   "Location of the waisindex executable. 
  28.    This comes in the bin directory of the wais release")
  29. (defvar *common-source-directory* (concat *wais-top-directory* "wais-sources/")
  30.   "Where the common sources for you site live.  nil if there are none")
  31.  
  32. (defvar *wais-maximum-result-documents* 40
  33.   "Maximum number of results to return for a question.  If you change this,
  34. be sure to kill the wais-receiving buffer.")
  35.  
  36. (defvar *wais-question-directory*
  37.     "~/wais-questions/"
  38.   "User's question directory")
  39. (defvar *wais-source-directory*
  40.     "~/wais-sources/"
  41.   "User's source directory")
  42. (defvar *wais-document-directory*
  43.     "~/wais-documents/"
  44.   "User's document directory")
  45.  
  46. (defvar wais-version 8)
  47.  
  48. (defvar *debug* nil)
  49.  
  50. (defvar *waisq-truncate-mode* t
  51.  "switch to set truncate mode in waisq buffers.  Set to nil for line wrap")
  52.  
  53. (defvar *wais-document-display-size* 4
  54.   "Number of lines of document headers to display when text is shown")
  55.  
  56. (defvar *wais-multiple-document-buffers* t
  57.   "If set to nil, use one buffer for all retrieved documents.
  58. A retrieval request will be issued each time a document is
  59. selected for editing.
  60. Otherwise, use Multiple buffers for retrieving Documents.
  61. Retrieval requests are made only once, and the buffer is reused.")
  62.  
  63. (defvar *wais-document-buffer* "Wais DOC"
  64.   "Name of buffer when *wais-multiple-document-buffers* is nil")
  65.  
  66. (defvar *x-viewers* 
  67.   (list (list "GIF" (concat *wais-top-directory* "bin/wais-gif-display"))
  68.     (list "TIFF" (concat *wais-top-directory* "bin/wais-tiff-display"))
  69.     (list "PICT" (concat *wais-top-directory* "bin/wais-pict-display")))
  70.   "Alist of Programs to use to view under X
  71. format: ((type viewer) (type viewer) ...)")
  72.  
  73. (defvar *wais-show-size* t
  74.   "Show size of document in results window")
  75.  
  76. (defvar *wais-show-date* t
  77.   "Show date of document in results window")
  78.  
  79. (defun current-line ()
  80.   "return the current line number (in the buffer) of point."
  81.   (save-restriction
  82.     (widen)
  83.     (save-excursion
  84.       (beginning-of-line)
  85.       (1+ (count-lines 1 (point))))))
  86.  
  87. (defconst *wais-client-machine* nil
  88.   "if set, this machine will be used to run *wais-binary-pathname* 
  89.    (using rsh)")
  90.  
  91. (defvar *wais-process* () "the variable that holds the wais process struct")
  92. (defvar *wais-receiving-buffer* "wais-receiving-buffer")
  93.  
  94. (defun shell-command-fast (string)
  95.   (let ((buf (get-buffer-create "*Shell Command Output*"))
  96.     )
  97.     (save-excursion
  98.       (set-buffer buf)
  99.       (erase-buffer))
  100.     (call-process shell-file-name nil buf nil "-f" "-c" string)
  101.     ))
  102.  
  103. (defun wais-toggle-multiple-buffers ()
  104.   "Switch between multiple WAIS DOC buffers and one WAIS DOC buffer"
  105.   (interactive)
  106.   (setq *wais-multiple-document-buffers*
  107.     (not *wais-multiple-document-buffers*))
  108.   (message (if *wais-multiple-document-buffers*
  109.            "Using multiple Document buffers"
  110.            "Using single Document buffer")))
  111.  
  112. (defun wais-find-process ()
  113.   "Check status of 'wais' process and start if necessary."
  114.   (unless (and *wais-process*
  115.            (eq (process-status *wais-process*) 'run))
  116.     (message "Starting new wais process...")
  117.     (and (get-buffer *wais-receiving-buffer*) 
  118.      (kill-buffer *wais-receiving-buffer*))
  119.     ;; bind process-connection-type to nil
  120.     ;; to avoid allocating a pty. -- taylor, 21 Oct 88
  121.     (let (
  122.       ;; this doesn't work on the NeXT.  Comment out this line.
  123.       (process-connection-type nil)
  124.       )
  125.       (if *wais-client-machine*
  126.       (setq *wais-process* 
  127.         (start-process "WAIS" *wais-receiving-buffer* 
  128.                    "rsh" *wais-client-machine*
  129.                    waisq-program "-"
  130.                    "-m"
  131.                    (format "%d" *wais-maximum-result-documents*)
  132.                    (if *common-source-directory*
  133.                    "-c" "")
  134.                    (if *common-source-directory*
  135.                    (expand-file-name *common-source-directory*)
  136.                    "")
  137.                    (if *wais-source-directory*
  138.                    "-s" "")
  139.                    (if *wais-source-directory*
  140.                    (expand-file-name *wais-source-directory*)
  141.                    "")))
  142.       (setq *wais-process* 
  143.         (start-process "WAIS" *wais-receiving-buffer*
  144.                    waisq-program "-"
  145.                    "-m"
  146.                    (format "%d" *wais-maximum-result-documents*)
  147.                    (if *common-source-directory*
  148.                    "-c" "")
  149.                    (if *common-source-directory*
  150.                    (expand-file-name *common-source-directory*)
  151.                    "")
  152.                    (if *wais-source-directory*
  153.                    "-s" "")
  154.                    (if *wais-source-directory*
  155.                    (expand-file-name *wais-source-directory*)
  156.                    "")))))
  157.     (process-kill-without-query *wais-process*)
  158.     (sit-for 3))
  159.   (let ((b (current-buffer)))
  160.     (set-buffer *wais-receiving-buffer*)
  161.     (emacs-lisp-mode)
  162.     (set-buffer b))
  163.   *wais-process*)
  164.  
  165. (defvar waisk-mode-map nil)
  166.  
  167. (unless waisk-mode-map
  168.   (setq waisk-mode-map (copy-keymap text-mode-map))
  169.   (define-key waisk-mode-map "\C-m" 'wais-query)
  170.   (define-key waisk-mode-map "\C-xk" 'wais-kill-buffer))
  171.  
  172. (defun waisk-mode ()
  173.   "Major mode for editting words for the question.
  174.  
  175. All the usual text-mode cursor movement works, except
  176.  
  177. RET     Go for it (answer the Question).
  178.  
  179. Entering this mode calls value of hook variable waisk-mode-hook."
  180.   (interactive)
  181.   (kill-all-local-variables)
  182.   (setq major-mode 'waisk-mode)
  183.   (setq mode-name "WaisK")
  184.   (use-local-map waisk-mode-map)
  185.   (set-syntax-table text-mode-syntax-table)
  186.   (run-hooks 'waisk-mode-hook))
  187.  
  188. (defvar wais-document nil)
  189.  
  190. (defvar waisd-mode-map nil)
  191.  
  192. (unless waisd-mode-map
  193.   (setq waisd-mode-map (copy-keymap text-mode-map))
  194.   (define-key waisd-mode-map "?" 'waisd-help)
  195.   (define-key waisd-mode-map "h" 'waisd-help)
  196.   (define-key waisd-mode-map "B" 'waisd-best-line)
  197.   (define-key waisd-mode-map "s" 'wais-add-section)
  198.   (define-key waisd-mode-map "\r" 'wais-query)
  199.   (define-key waisd-mode-map " " 'scroll-up)
  200.   (define-key waisd-mode-map "\C-?" 'scroll-down)
  201.   (define-key waisd-mode-map "q" 'waisd-exit))
  202.  
  203. (defvar *waisd-mode-string*
  204.     "Major mode in effect in a wais document buffer.
  205.  
  206.    Movement commands:
  207.  
  208.    All the usual text-mode cursor movement work.
  209.    In addition the following commands are available:
  210.  
  211.    B       Go to the best line in the document
  212.    space   Scroll document forward.
  213.    delete  Scroll document backward.
  214.  
  215.    Action Commands:
  216.  
  217.    s       Add the marked region as a section to the Relevant Documents.
  218.    ? or h  Show this message (Help).
  219.    q       quit reading this document.  bury this buffer, and the Question
  220.            buffer associated with it.
  221.  
  222.    When you retrieve a source you will see the source description form in
  223.    the document buffer.  To save this for use in subsequent searches,
  224.    simply use the \"S\" command in the results window, or the standard
  225.    Emacs save-file function (control-x control-s, or M-x save-file).  If
  226.    you use the save-file function, be sure to add the .src suffix so the
  227.    interface will recognize this as a source.  The \"S\" function will add
  228.    the suffix for you.
  229.  
  230. Entering this mode calls value of hook variable waisd-mode-hook."
  231. )
  232.  
  233. (defun waisd-mode ()
  234.   "Major mode for WAIS documents.  Use M-x waisd-help for more information."
  235.   (interactive)
  236.   (kill-all-local-variables)
  237.   (make-variable-buffer-local 'wais-document)
  238.   (make-variable-buffer-local 'current-question)
  239.   (make-variable-buffer-local 'current-question-filename)
  240.   (make-variable-buffer-local 'question-name)
  241.   (make-variable-buffer-local 'wais-best-line)
  242.   (setq wais-document t)
  243.   (setq major-mode 'waisd-mode)
  244.   (setq mode-name "Wais DOC")
  245.   (use-local-map waisd-mode-map)
  246.   (set-syntax-table text-mode-syntax-table)
  247.   (run-hooks 'waisd-mode-hook))
  248.  
  249. (defvar waisq-mode-map nil)
  250.  
  251. (defun init-waisq-mode-map ()
  252.   (suppress-keymap waisq-mode-map)
  253.   (define-key waisq-mode-map "n" 'wais-edit-next-msg)
  254.   (define-key waisq-mode-map "p" 'wais-edit-previous-msg)
  255.   (define-key waisq-mode-map "\C-n" 'wais-next-msg)
  256.   (define-key waisq-mode-map "\C-p" 'wais-previous-msg)
  257.   (define-key waisq-mode-map "+" 'wais-edit-next-resdoc)
  258.   (define-key waisq-mode-map "-" 'wais-edit-previous-resdoc)
  259.   (define-key waisq-mode-map "a" 'wais-add-reldoc)
  260.   (define-key waisq-mode-map "d" 'wais-delete-reldocs)
  261.   (define-key waisq-mode-map "A" 'wais-add-source)
  262.   (define-key waisq-mode-map "D" 'wais-delete-sources)
  263.   (define-key waisq-mode-map "g" 'wais-query)
  264.   (define-key waisq-mode-map "G" 'wais-query)
  265.   (define-key waisq-mode-map "\r" 'wais-query)
  266.   (define-key waisq-mode-map "q" 'wais-exit)
  267.   (define-key waisq-mode-map "Q" 'wais-quit)
  268.   ;;more to come:
  269.   (define-key waisq-mode-map "e" 'wais-edit)
  270.   (define-key waisq-mode-map "f" 'wais-edit)
  271.   (define-key waisq-mode-map "v" 'wais-edit)
  272.   (define-key waisq-mode-map "h" 'wais-help)
  273.   (define-key waisq-mode-map "?" 'wais-help)
  274.   (define-key waisq-mode-map "N" 'wais-create-question)
  275.   (define-key waisq-mode-map "k" 'wais-goto-keywords)
  276.   (define-key waisq-mode-map "K" 'wais-goto-keywords)
  277.   (define-key waisq-mode-map " " 'wais-scroll-msg-up)
  278.   (define-key waisq-mode-map "" 'wais-scroll-msg-down)
  279.   (define-key waisq-mode-map "s" 'wais-select-question)
  280.   (define-key waisq-mode-map "S" 'wais-save-document)
  281.   (define-key waisq-mode-map "m" 'wais-toggle-multiple-buffers)
  282.   (define-key waisq-mode-map "B" 'waisq-best-line)
  283.   (define-key waisq-mode-map "\C-l" 'wais-redisplay)
  284.   (define-key waisq-mode-map "\C-xk" 'wais-kill-buffer))
  285.  
  286. (unless waisq-mode-map
  287.   (setq waisq-mode-map (make-keymap))
  288.   (init-waisq-mode-map))
  289.  
  290. (defvar *waisq-mode-string*
  291.     "Major mode in effect in a wais question buffer.
  292.  
  293.    Movement commands:
  294.  
  295.    C-n     Move to next document, or arg documents.
  296.    C-p     Move to previous document, or arg documents.
  297.    e,f,v   Edit, Find or View the current document (all are synonymous).
  298.    n       Edit to next document, or arg documents.
  299.    p       Edit to previous document, or arg documents.
  300.    space   Scroll document in other window forward.
  301.    delete  Scroll document backward.
  302.    B       Go to the best line in the document
  303.    C-l     Refresh Display and reset Question Window.
  304.  
  305.    Sources:
  306.  
  307.    A       Add a source to the question.
  308.    D       Delete all sources from the question.
  309.  
  310.    Relevance Feedback:
  311.  
  312.    a       Add the current document to the question.
  313.    d       Delete all relevant documents from the question.
  314.  
  315.    Action Commands:
  316.  
  317.    k       Replace the 'Find documents on' words
  318.    G,RET   Go for it (submit the query).
  319.    N       Make a new question.
  320.    m       Toggle multiple document buffer mode. 
  321.    s       Select another question.
  322.    S       Save this document to a file.
  323.    ? or h  Show this message (Help).
  324.    q       quit WaisQ, but keep the question's buffer.
  325.    Q       Quit WaisQ and kill this question's buffer.
  326.  
  327.    New users should try M-x wais-novice.
  328.  
  329.    Entering this mode calls value of hook variable waisq-mode-hook.
  330.  
  331.    Some notes on retrieving and saving sources (from the directory of servers,
  332.    or from the help query):
  333.  
  334.    When you retrieve a source you will see the source description form in
  335.    the document buffer.  To save this for use in subsequent searches,
  336.    simply use the \"S\" command in the results window, or the standard
  337.    Emacs save-file function (control-x control-s, or M-x save-file).  If
  338.    you use the save-file function, be sure to add the .src suffix so the
  339.    interface will recognize this as a source.  The \"S\" function will add
  340.    the suffix for you.
  341. ")
  342.  
  343. (defun wais-help ()
  344.   "Display the special commands available in WaisQ mode"
  345.   (interactive)
  346.   (let ((waisqp (and (boundp 'question-name)
  347.              question-name)))
  348.     (when waisqp
  349.       (wais-redisplay-internal)
  350.       (when wais-split
  351.     (setq wais-split nil)
  352.     (split-window (get-buffer-window (current-buffer))*wais-document-display-size*))
  353.       (other-window 1))
  354.     (switch-to-buffer (get-buffer-create "*Help*"))
  355.     (erase-buffer)
  356.     (unless waisqp
  357.       (insert "                            Gnu Emacs WAIS.
  358.  
  359. Use M-x wais, M-x wais-select-question or M-x wais-create-question 
  360. to get into WaisQ mode.
  361.  
  362. "))
  363.     (insert *waisq-mode-string*)
  364.     (newline 2)
  365.     (insert "  Configuration variables:")
  366.     (newline 2)
  367.     (insert "  Using multiple Document buffers: "
  368.         (if *wais-multiple-document-buffers*
  369.         "Yes." "No."))
  370.     (goto-char (point-min))
  371.     (if waisqp
  372.     (other-window -1))))
  373.  
  374. (defun waisd-help ()
  375.   "Display the special commands available in WaisQ mode"
  376.   (interactive)
  377.   (switch-to-buffer (get-buffer-create "*Help*"))
  378.   (erase-buffer)
  379.   (insert *waisd-mode-string*)
  380.   (newline 2)
  381.   (insert "  Configuration variables:")
  382.   (newline 2)
  383.   (insert "  Using multiple Document buffers: "
  384.       (if *wais-multiple-document-buffers*
  385.           "Yes." "No."))
  386.   (goto-char (point-min))
  387.   (waisd-mode))
  388.  
  389. (defun waisq-mode ()
  390.   "Major mode for editting WAIS questions.  Use M-x wais-help to see more"
  391.   (interactive)
  392.   (if (check-init-directories)
  393.       (progn
  394.     (wais-create-question "Quick" "?" "directory-of-servers.src")
  395.     (wais-query))
  396.       (progn
  397.     (setq major-mode 'waisq-mode)
  398.     (setq mode-name "WaisQ")
  399.     (if (eq wais-buffer-type 'keys)
  400.         (use-local-map waisk-mode-map)
  401.         (use-local-map waisq-mode-map))
  402.     (make-variable-buffer-local 'wais-buffer-type)
  403.     (make-variable-buffer-local 'question-name)
  404.     (make-variable-buffer-local 'current-question-filename)
  405.     (make-variable-buffer-local 'current-question)
  406.     (make-variable-buffer-local 'headlines)
  407.     (make-variable-buffer-local 'wais-split)
  408.     (setq wais-split t)
  409.     (setq truncate-lines *waisq-truncate-mode*)
  410.     (setq buffer-read-only t)
  411.     (setq tab-width 5)
  412.     (set-syntax-table emacs-lisp-mode-syntax-table)
  413.     (run-hooks 'waisq-mode-hook))))
  414.  
  415. (defun load-question (file)
  416.   (let ((filename (expand-file-name (concat *wais-question-directory* file))))
  417.     (load-question-internal filename file)))
  418.  
  419. (defun quiet-replace-string (from-string to-string)
  420.   (while (search-forward from-string nil t)
  421.     (replace-match to-string t t)))
  422.  
  423. (defun load-question-internal (filename name)
  424.   (find-file filename)
  425.   (emacs-lisp-mode)
  426.   (goto-char (point-min))
  427.   (save-excursion
  428.     (quiet-replace-string "#s(" "("))
  429.   (save-excursion
  430.     (quiet-replace-string "#(" "("))
  431.   (save-excursion
  432.     (quiet-replace-string "d003" ""))
  433.   (save-excursion
  434.     (quiet-replace-string "d004" ""))
  435.   (save-excursion
  436.     (quiet-replace-string "(" ""))
  437.   (save-excursion
  438.     (quiet-replace-string ")" ""))
  439.   (save-excursion
  440.     (quiet-replace-string "\"" "\""))
  441.   (save-excursion
  442.     (quiet-replace-string "" ""))
  443.   (save-excursion
  444.     (quiet-replace-string "" ""))
  445.   (save-excursion
  446.     (quiet-replace-string "
  447. \"" "\""))
  448.   (let ((result (read (current-buffer))))
  449.     (set-buffer-modified-p nil)
  450.     (kill-buffer (current-buffer))
  451.     result))
  452.  
  453. (defun dateof (date)
  454.   (if (= (length date) 6)
  455.       (let ((result (make-string 8 ?/)))
  456.     (setf (aref result 0) (aref date 2))
  457.     (setf (aref result 1) (aref date 3))
  458.     (setf (aref result 3) (aref date 4))
  459.     (setf (aref result 4) (aref date 5))
  460.     (setf (aref result 6) (aref date 0))
  461.     (setf (aref result 7) (aref date 1))
  462.     result)
  463.       ""))
  464.  
  465. (defun any-from-anystring (anystring)
  466.   "return an elisp any from a string that contains an any"
  467.   (let ((l (length anystring)))
  468.     (dotimes (i l)
  469.       (if (= (aref anystring i) ?#)
  470.       (setf (aref anystring i) 32))))
  471.   (read anystring))
  472.  
  473. (defun anystring-to-string (anystring)
  474.   "creates a regular old string from an anystring"
  475.   (any-to-string (any-from-anystring anystring)))
  476.  
  477. (defun any-to-string (any)
  478.   "create a string from an elisp ANY"
  479.   (let* ((size (second (member ':size any)))
  480.      (bytes (second (member ':bytes any)))
  481.      (result (make-string size 0))
  482.      (i 0))
  483.     (dolist (el bytes)
  484.       (setf (aref result i) el)
  485.       (incf i))
  486.     result))
  487.  
  488. (defun string-to-any (string)
  489.   "create an elisp any from a STRING"
  490.   (let ((l (length string))
  491.     bytes)
  492.     (dotimes (i l)
  493.       (push (aref string i) bytes))
  494.     (list ':any ':size l ':bytes (reverse bytes))))
  495.  
  496. (defun print-any (any)
  497.   "Returns a string which is the printed representation of an any"
  498.   (let* ((size (second (member ':size any)))
  499.      (bytes (second (member ':bytes any)))
  500.      (result (format "(:any :size %d :bytes #( " size)))
  501.     (dolist (el bytes)
  502.       (setq result (concat result (format "%d " el))))
  503.     (concat result ") )")))
  504.  
  505. (defun get-keys (question)
  506.   (second (member ':seed-words question)))
  507.  
  508. (defun get-reldocs (question)
  509.   (second (member ':relevant-documents question)))
  510.  
  511. (defun get-sources (question)
  512.   (second (member ':sources question)))
  513.  
  514. (defun get-resdocs (question)
  515.   (second (member ':result-documents question)))
  516.  
  517. (defun get-document (docid)
  518.   (second (member ':document docid)))
  519.  
  520. (defun get-score (docid)
  521.   (second (member ':score docid)))
  522.  
  523. (defun get-type (docid)
  524.   (second (member ':type docid)))
  525.  
  526. (defun get-headline (document)
  527.   (second (member ':headline document)))
  528.  
  529. (defun get-date (document)
  530.   (second (member ':date document)))
  531.  
  532. (defun get-size (document)
  533.   (second (member ':number-of-bytes document)))
  534.  
  535. (defun get-start (docid)
  536.   (second (member ':line-pos
  537.           (second (member ':start docid)))))
  538.  
  539. (defun get-end (docid)
  540.   (second (member ':line-pos
  541.           (second (member ':end docid)))))
  542.  
  543. (defun headlist (doclist)
  544.   (let ((result nil)
  545.     document)
  546.     (dolist (docid doclist)
  547.       (setq document (get-document docid))
  548.       (push (list (get-score docid)
  549.           (get-headline document)
  550.           (get-date document)
  551.           (get-size document))
  552.         result))
  553.     (reverse result)))
  554.  
  555. (defun rellist (doclist)
  556.   (let ((result nil)
  557.     document)
  558.     (dolist (docid doclist)
  559.       (setq document (get-document docid))
  560.       (push (list (get-start docid)
  561.           (get-end docid)
  562.           (get-headline (get-document docid))
  563.           (get-date document))
  564.         result))
  565.     (reverse result)))
  566.  
  567. (defun get-sourcename (source)
  568.   (second (member ':filename source)))
  569.  
  570. (defun sourcelist (sourcelist)
  571.   (let ((result nil))
  572.     (dolist (sid sourcelist)
  573.       (push (get-sourcename sid)
  574.         result))
  575.     (reverse result)))
  576.  
  577. (defun find-wais-buffer (name type)
  578.   (let ((result (get-buffer name)))
  579.     (unless result
  580.       (setq result (get-buffer-create name))
  581.       (switch-to-buffer result)
  582.       (setq wais-buffer-type type)
  583.       (waisq-mode))
  584.     (switch-to-buffer result)
  585.     (waisq-mode)
  586.     result))
  587.  
  588. (defun wais-redisplay-internal ()
  589.   (if (and (boundp 'question-name)
  590.        question-name)
  591.       (let ((name question-name))
  592.     (setup-wais-display name)
  593.     (if (not (eql name question-name))
  594.         (display-question name)))
  595.     (error "Not a question buffer.")))
  596.  
  597. (defun wais-redisplay ()
  598.   "Rebuild the WAISQ display"
  599.   (interactive)
  600.   (wais-redisplay-internal)
  601.   (recenter))
  602.  
  603. (defun setup-wais-display (name)
  604.   (let ((buff (find-wais-buffer (concat name ": Find Documents On")
  605.                 'keys)))
  606.     (delete-other-windows)
  607.     (split-window
  608.      (get-buffer-window buff) 4))
  609.   (setq mode-line-format "-Find Documents On-----%p-%-")
  610.   (setq buffer-read-only nil)
  611.   (other-window 1)
  612.   (split-window
  613.    (get-buffer-window
  614.     (find-wais-buffer (concat name ": On Sources") 'source))
  615.    4)
  616.   (setq mode-line-format '(20 "-On Sources---%p-%-"))
  617.   (other-window 1)
  618.   (find-wais-buffer (concat name ": Results") 'result)
  619.   (setq wais-split t)
  620.   (other-window -1)
  621.   (split-window-horizontally 20)
  622.   (other-window 1)
  623.   (find-wais-buffer (concat name ": Similar To") 'relevant)
  624.   (setq mode-line-format "--Similar To------%p-%-")  
  625.   (other-window 1))
  626.  
  627. (defun set-buffer-variables (question name filename resheads)
  628.   (setq current-question question)
  629.   (setq question-name name)
  630.   (setq current-question-filename filename)
  631.   (setq headlines resheads)
  632.   (setq default-directory *wais-question-directory*)
  633.   (set-buffer-modified-p nil))
  634.  
  635. (defun display-question (name &optional file message)
  636.   (let ((q (if file
  637.            (load-question-internal file name)
  638.            (load-question name))))
  639.     (display-question-internal 
  640.      (if file file (expand-file-name (concat *wais-question-directory* name)))
  641.      name q message)))
  642.  
  643. (defun insert-headline (line)
  644.   (insert 
  645.     (concat "" (first line) "    "
  646.         (if *wais-show-size*
  647.         (if (< (fourth line) 1024)
  648.             (format "%d\t" (fourth line))
  649.             (format "%dK\t" (/ (fourth line) 1024)))
  650.         "")
  651.         (if *wais-show-date*
  652.         (if (string= (third line) "0")
  653.             " No Date  "
  654.             (concat "(" (dateof (third line)) ") "))
  655.         "")))
  656.   (let* ((headline (second line))
  657.      (l (length headline))
  658.      c)
  659.     (dotimes (i l)
  660.       (setq c (aref headline i))
  661.       (insert c)
  662.       (if (= c 10)
  663.       (insert "                ")))))
  664.  
  665. (defun display-question-internal (filename name q &optional message)
  666.   (let ((keys (get-keys q))
  667.     (sourcenames (sourcelist (get-sources q)))
  668.     (relheads (rellist (get-reldocs q)))
  669.     (resheads (headlist (get-resdocs q)))
  670.     keybuff sourcebuff relbuff resbuff)
  671.     (setup-wais-display name)
  672.     (if message (message message))
  673.     (setq keybuff (find-wais-buffer (concat name ": Find Documents On") 'keys))
  674.     (setq buffer-read-only nil)
  675.     (erase-buffer)
  676.     (insert keys)
  677.     (goto-char (point-min))
  678.     (set-buffer-variables q name filename resheads)
  679.     (setq sourcebuff (find-wais-buffer (concat name ": On Sources") 'source))
  680.     (setq buffer-read-only nil)
  681.     (erase-buffer)
  682.     (setq truncate-lines *waisq-truncate-mode*)
  683.     (auto-fill-mode -1)
  684.     (set-buffer-variables q name filename resheads)
  685.     (if sourcenames
  686.     (let ((sorted-sourcenames
  687.            (sort sourcenames
  688.              '(lambda (a b) (string< a b)))))
  689.       (dolist (line sorted-sourcenames)
  690.         (insert (concat " " line))
  691.         (newline)))
  692.     (insert " No Sources"))
  693.     (goto-char (point-min))
  694.     (setq buffer-read-only t)
  695.     (setq relbuff (find-wais-buffer (concat name ": Similar To") 'relevant))
  696.     (setq buffer-read-only nil)
  697.     (erase-buffer)
  698.     (setq truncate-lines *waisq-truncate-mode*)
  699.     (auto-fill-mode -1)
  700.     (set-buffer-variables q name filename resheads)
  701.     (if relheads
  702.     (dolist (line relheads)
  703.       (if (first line)
  704.           (insert (format " [%d,%d] %s%s"
  705.                   (first line) (second line)
  706.                   (if (string= (fourth line) "0")
  707.                   "" (concat "(" (dateof (fourth line)) ") "))
  708.                   (third line)))
  709.           (insert (concat " "
  710.                   (if (string= (fourth line) "0")
  711.                   "" (concat "(" (dateof (fourth line)) ") "))
  712.                   (third line))))
  713.       (newline))
  714.     (insert " No documents"))
  715.     (goto-char (point-min))
  716.     (setq buffer-read-only t)
  717.     (setq resbuff (find-wais-buffer (concat name ": Results") 'result))
  718.     (setq buffer-read-only nil)
  719.     (erase-buffer)
  720.     (setq truncate-lines *waisq-truncate-mode*)
  721.     (auto-fill-mode -1)
  722.     (set-buffer-variables q name filename resheads)
  723.     (if resheads
  724.     (progn
  725.       (dolist (line resheads)
  726.         (insert-headline line)
  727.         (newline))
  728.       (delete-char -1))
  729.     (insert "No documents"))
  730.     (goto-char (point-min))
  731.     (setq buffer-read-only t)
  732.     q))
  733.  
  734. (defun wais-next-line ()
  735.   (while (string-equal (buffer-substring (point) (1+ (point))) "    ")
  736.     (next-line 1)
  737.     (beginning-of-line nil)))
  738.  
  739. (defun wais-prev-line ()  
  740.   (do () 
  741.       ((not (string-equal (buffer-substring (point) (1+ (point))) "    ")))
  742.     (next-line -1)
  743.     (beginning-of-line nil)))
  744.  
  745. (defun wais-next-msg (number)
  746.   "Move the cursor to the next (arg) Document"
  747.   (interactive "p")
  748.   (if (null number) (setq number 1))
  749.   (let ((direction (if (plusp number) 1 -1)))
  750.     (dotimes (i (abs number))
  751.       (next-line direction)
  752.       (if (> direction 0)
  753.       (wais-next-line)
  754.       (wais-prev-line)))))
  755.  
  756. (defun wais-previous-msg (number)
  757.   "Move the cursor to the previous (arg) Document"
  758.   (interactive "p")
  759.   (wais-next-msg (- (if number number 1))))
  760.  
  761. (defun wais-edit (&optional n)
  762.   "Retrieve the Current Document"
  763.   (interactive "p")
  764.   (wais-edit-next-msg 0))
  765.  
  766. (defun line-to-doc ()
  767.   (save-excursion
  768.     (beginning-of-line nil)
  769.     (let ((here (point))
  770.       (result 1))
  771.       (goto-char (point-min))
  772.       (while (< (point) here)
  773.     (wais-next-msg 1)
  774.     (incf result))
  775.       result)))
  776.  
  777. (defun wais-edit-next-msg (&optional n)
  778.   "Retrieve the next (arg) Document"
  779.   (interactive "p")
  780.   (wais-next-msg n)
  781.   (edit-document current-question-filename (line-to-doc)))
  782.  
  783. (defun wais-edit-previous-msg (&optional n)
  784.   "Retrieve the previous (arg) Document"
  785.   (interactive "p")
  786.   (wais-edit-next-msg (if n (- n) -1)))
  787.  
  788. (defun show-dialog (time &optional size message)
  789.   (unless size
  790.     (setq size 4))
  791.   (cond ((< (window-height) (+ 2 size))
  792.      ;;dont split window, too small
  793.      (save-excursion
  794.        (switch-to-buffer *wais-receiving-buffer*)
  795.        (goto-char (point-min))
  796.        (if (numberp time)
  797.            (progn (if message
  798.               (message message))
  799.               (sit-for time))
  800.            (read-input (concat (if message message "")
  801.                    " Press return to continue")))))
  802.     (t
  803.       (save-window-excursion
  804.         (split-window (get-buffer-window (current-buffer)) 
  805.               (- (window-height) size))
  806.         (other-window 1)
  807.         (switch-to-buffer *wais-receiving-buffer*)
  808.         (save-excursion
  809.           (goto-char (point-min))
  810.           (if (numberp time)
  811.           (progn (if message
  812.                  (message message))
  813.              (sit-for time))
  814.           (read-input (concat (if message message "")
  815.                       " Press return to continue"))))
  816.         (bury-buffer (current-buffer))))))
  817.  
  818. (defun wais-query (&optional stuff)
  819.   "Answer this Question"
  820.   (interactive)
  821.   (let (result
  822.     file
  823.     (message "Asking the question..."))
  824.     (update-keywords question-name)
  825.     (wais-redisplay-internal)
  826.     (setq buffer-read-only nil)
  827.     (erase-buffer)
  828.     (setq buffer-read-only t)
  829.     (sit-for 0)
  830.     (message message)
  831.     (setq file current-question-filename)
  832.     (setq name question-name)
  833.     (setq result
  834.       (wais-query-internal file name message))
  835.     (message "Asking the question...done.")
  836.     (if result
  837.     (save-excursion
  838.       (set-buffer *wais-receiving-buffer*)
  839.       (goto-char (point-min))
  840.       (search-forward "Found")
  841.       (beginning-of-line)
  842.       (message (buffer-substring (point)
  843.                      (progn
  844.                        (end-of-line)
  845.                        (point)))))
  846.     (display-question name file
  847.               "Incomplete Transaction.  Question Unmodified."))))
  848.  
  849. (defun update-keywords (name)
  850.   (save-excursion
  851.     (set-buffer 
  852.       (find-wais-buffer (concat name ": Find Documents On")
  853.             'keys))
  854.     (if current-question-filename
  855.     (wais-replace-keywords (buffer-substring (point-min) (point-max))))))
  856.  
  857.  
  858. (defun wais-query-internal (file name &optional message)
  859.   (let (result)
  860.     (update-keywords name)
  861.     (condition-case e
  862.      (let (command-string)
  863.        (find-file file)
  864.        (emacs-lisp-mode)
  865.        (goto-char (point-min))
  866.        (if (search-forward ":result-documents" nil t)
  867.            (setq command-string
  868.              (concat (buffer-substring (point-min)
  869.                            (progn
  870.                          (forward-char -17)
  871.                          (point))) ")"))
  872.            (setq command-string
  873.              (concat (buffer-substring (point-min) (point-max))
  874.                  "
  875. ")))
  876.        (kill-buffer (current-buffer))
  877.        (message message)
  878.        (wais-find-process)
  879.        (set-buffer *wais-receiving-buffer*)
  880.        (erase-buffer)
  881.        (process-send-string (wais-find-process) command-string)
  882.        (accept-process-output (wais-find-process))
  883.        (if (not (eq (process-status *wais-process*) 'run))
  884.            (error "WAIS process died. Look in buffer %s for clues."
  885.               *wais-receiving-buffer*))
  886.        (goto-char (point-min))
  887.        (setq result t)
  888.        (while (not (search-forward " (:question"
  889.                        nil t))
  890.          (accept-process-output *wais-process*)
  891.          (goto-char (point-min))
  892.          (if (or (save-excursion
  893.                (search-forward "Bad Connection"
  894.                        (save-excursion
  895.                      (if (search-forward " (:question" nil t)
  896.                          (point)))
  897.                        t))
  898.              (save-excursion
  899.                (search-forward "Connection refused"
  900.                        (save-excursion
  901.                      (if (search-forward " (:question" nil t)
  902.                          (point)))
  903.                        t)))
  904.          (progn
  905.            (setq result nil)
  906.            (show-dialog t 4 "Looks like a bad connection.")))
  907.          (if (save-excursion
  908.            (search-forward "This Question has no sources"
  909.                    (save-excursion
  910.                      (if (search-forward " (:question" nil t)
  911.                      (point)))
  912.                    t))
  913.          (progn
  914.            (setq result nil)
  915.            (show-dialog t 4 "No Source.  Press 'A' to add one. ")))
  916.          (if (save-excursion
  917.            (re-search-forward "[^\\]Code: [a-zA-Z0-9][a-zA-Z0-9],"
  918.                       (save-excursion
  919.                     (if (search-forward " (:question" nil t)
  920.                         (point)))
  921.                       t))
  922.          (progn
  923.            (show-dialog t 4 "Diagnostic Error")))
  924.          (if (save-excursion
  925.            (search-forward "Couldn't find source"
  926.                    (save-excursion
  927.                      (if (search-forward " (:question" nil t)
  928.                      (point)))
  929.                    t))
  930.          (progn
  931.            (setq result nil)
  932.            (show-dialog t 4 "Looks like a bad source spec.")))
  933.          (if (not (eq (process-status *wais-process*) 'run))
  934.          (error "WAIS process died. Look in buffer %s for clues."
  935.             *wais-receiving-buffer*))
  936.          (goto-char (point-min)))
  937.        (if result
  938.            (progn
  939.          (while (not (search-forward "Waisq: Ready for next question."
  940.                          nil t))
  941.            (accept-process-output *wais-process*)
  942.            (goto-char (point-min)))
  943.          (goto-char (point-min))
  944.          (let ((match "(:question"))
  945.            (search-forward match)
  946.            (setq command-string
  947.              (buffer-substring
  948.                (- (point) (length match))
  949.                (let ((end "Waisq: Ready for next question."))
  950.                  (search-forward end)
  951.                  (forward-char (- (length end)))
  952.                  (point))))
  953.            (find-file file)
  954.            (erase-buffer)
  955.            (insert command-string)
  956.            (let ((require-final-newline nil))
  957.              (save-buffer 0))
  958.            (kill-buffer (current-buffer))
  959.            (setq message (format "%sdone." message))
  960.            (message message)
  961.            (display-question name
  962.                      file message)))))
  963.        (error
  964.      (show-dialog t 6 "Something wrong with query"))
  965.        (quit
  966.      (display-question name file)
  967.      (message "Abort Query!")
  968.      (unless *debug*
  969.        (kill-buffer *wais-receiving-buffer*))))
  970.     result))
  971.  
  972. (defun get-source-filename (file)
  973.   "Get source file name, adding .src if necessary"
  974.   (interactive "FSource file name: ")
  975.   (if (null file)
  976.       (setq file
  977.         (read-file-name "Source file name: ")))
  978.   (let ((len (length file)))
  979.     (if (string= (substring file -4) ".src")
  980.           file
  981.           (concat file ".src"))))
  982.  
  983. (defun wais-save-document (&rest foo)
  984.   "Save this document to a file"
  985.   (interactive)
  986.   (wais-edit)
  987.   (condition-case foo
  988.        (progn
  989.      (other-window 1)
  990.      (if (string= default-directory *wais-source-directory*)
  991.          (write-file (get-source-filename nil))
  992.          (save-buffer))
  993.      (other-window -1))
  994.      (quit
  995.        (message "Abort!")
  996.        (wais-redisplay))))
  997.   
  998.  
  999. (defun wais-exit (&optional foo)
  1000.   "Leave this Question"
  1001.   (interactive)
  1002.   (let ((current (current-buffer)))
  1003.     (bury-doc-buffers)
  1004.     (switch-to-buffer current))
  1005.   (wais-redisplay-internal)
  1006.   (delete-other-windows)
  1007.   (dotimes (i 4)
  1008.     (bury-buffer))
  1009.   (if (member major-mode 
  1010.           '(waisq-mode waisd-mode waisk-mode))
  1011.       (wais-redisplay-internal)))
  1012.  
  1013. (defun wais-quit (&optional foo)
  1014.   "Kill this Question (and all it's buffers)"
  1015.   (interactive)
  1016.   (let ((current (current-buffer)))
  1017.     (bury-doc-buffers)
  1018.     (switch-to-buffer current))
  1019.   (wais-redisplay-internal)
  1020.   (delete-other-windows)
  1021.   (dotimes (i 4)
  1022.     (kill-buffer (current-buffer)))
  1023.   (and (get-buffer *wais-receiving-buffer*) 
  1024.        (kill-buffer *wais-receiving-buffer*))
  1025.   (if (member major-mode 
  1026.           '(waisq-mode waisd-mode waisk-mode))
  1027.       (wais-redisplay-internal)))
  1028.  
  1029. (defun waisd-exit (&optional foo)
  1030.   "Burry this Document buffer, and the Question that made it"
  1031.   (interactive)
  1032.   (other-window -1)
  1033.   (let ((current (current-buffer)))
  1034.     (bury-doc-buffers)
  1035.     (switch-to-buffer current))
  1036.   (wais-redisplay-internal)
  1037.   (delete-other-windows)
  1038.   (dotimes (i 4)
  1039.     (bury-buffer))
  1040.     (if (member major-mode 
  1041.           '(waisq-mode waisd-mode waisk-mode))
  1042.       (wais-redisplay-internal)))
  1043.  
  1044. ;;; to make kill-buffer a little more tollerant:
  1045.  
  1046. (defun wais-kill-buffer (&rest args)
  1047.   (interactive)
  1048.   (if (eq major-mode 'waisq-mode)
  1049.       (if (yes-or-no-p "Really kill this question? ")
  1050.       (wais-quit))))
  1051.  
  1052. (defun get-resdoc (num file)
  1053.   (let (result)
  1054.     (save-excursion
  1055.       (find-file file)
  1056.       (emacs-lisp-mode)
  1057.       (goto-char (point-min))
  1058.       (search-forward ":result-documents")
  1059.       (search-forward ":document-id" nil t num)
  1060.       (let ((loc (- (point) 15)))
  1061.     (goto-char loc)
  1062.     (forward-char 13)
  1063.     (if (search-forward ":document-id" nil t)
  1064.         ;;(forward-sexp 1) - doesn't work correctly.
  1065.         (setq result (buffer-substring loc (- (point) 13)))
  1066.         (goto-char (1- (point-max)))
  1067.         (dotimes (i 2)
  1068.           (while (not (string= (buffer-substring (point) (1+ (point)))
  1069.                    ")"))
  1070.         (backward-char)))
  1071.         (setq result (buffer-substring loc (- (point) 13)))))
  1072.       (kill-buffer (current-buffer)))
  1073.     result))
  1074.  
  1075. (defun next-or-prev-doc (doc nextp)
  1076.   (let ((obuf (current-buffer))
  1077.     (buf (get-buffer-create " *wais-resdoc-tmp-buffer"))
  1078.     result)
  1079.     (switch-to-buffer buf)
  1080.     (erase-buffer)
  1081.     (insert doc)
  1082.     (goto-char (point-min))
  1083.     (search-forward ":type")
  1084.     (kill-line)
  1085.     (insert 
  1086.       (if nextp
  1087.       " \"WAIS_NEXT\""
  1088.       " \"WAIS_PREV\""))
  1089.     (setq result (buffer-substring (point-min) (point-max)))
  1090.     (kill-buffer buf)
  1091.     (switch-to-buffer obuf)
  1092.     result))
  1093.  
  1094. (defun wais-add-reldoc (&optional num)
  1095.   "Add the current Document to the Question"
  1096.   (interactive)
  1097.   (let* ((doc (current-line))
  1098.      (line (second (nth (1- doc) headlines)))
  1099.      (file current-question-filename)
  1100.      (name question-name))
  1101.     (update-keywords name)
  1102.     (save-excursion
  1103.       (let ((string (get-resdoc doc file)))
  1104.     (find-file file)
  1105.     (goto-char (point-min))
  1106.     (search-forward ":relevant-documents")
  1107.     (search-forward "( ")
  1108.     (insert string))
  1109.       (let ((require-final-newline nil))
  1110.     (save-buffer 0))
  1111.       (kill-buffer (current-buffer))
  1112.       (display-question name))
  1113.     (find-wais-buffer (concat name ": Results") 'result)
  1114.     (goto-line doc)))
  1115.  
  1116. (defun wais-delete-reldocs (&optional num)
  1117.   "Remove all 'Similar To' Documents from this Question"
  1118.   (interactive)
  1119.   (let ((doc (current-line))
  1120.     (file current-question-filename)
  1121.     (name question-name))
  1122.     (update-keywords name)
  1123.     (find-file file)
  1124.     (emacs-lisp-mode)
  1125.     (goto-char (point-min))
  1126.     (search-forward ":relevant-documents")
  1127.     (search-forward "(")
  1128.     (backward-char 1)
  1129.     (let ((loc (point)))
  1130.       (forward-sexp 1)
  1131.      (setq loc (point))
  1132.      (forward-sexp -1)
  1133.      (delete-char (- loc (point)))
  1134.      (insert "(  )
  1135.       "))
  1136.        (let ((require-final-newline nil))
  1137.      (save-buffer 0))
  1138.        (kill-buffer (current-buffer))
  1139.        (display-question name current-question-filename)
  1140.        (goto-line doc)))
  1141.  
  1142. (defun get-doc-type (document)
  1143.   (second (member ':type document)))
  1144.  
  1145. (defun get-doc-best-line (document)
  1146.   (second (member ':best-line document)))
  1147.  
  1148. (defun type-from-number (question number)
  1149.   (get-doc-type (get-document (nth (1- number)
  1150.                    (get-resdocs question)))))
  1151.  
  1152. (defun best-line-from-number (question number)
  1153.   (get-doc-best-line (get-document (nth (1- number)
  1154.                     (get-resdocs question)))))
  1155.  
  1156. (defun get-filename (string)
  1157.   (let ((first-space (do ((i 0 (1+ i)))
  1158.              ((or (= i (length string)) 
  1159.                   (= (aref string i) ? )
  1160.                   (= (aref string i) ?_))
  1161.               i))))
  1162.     (substring string 0 first-space)))
  1163.  
  1164. (defun wais-find-viewer (type)
  1165.   (do ((e (first *x-viewers*) (first rest))
  1166.        (rest (cdr *x-viewers*) (cdr rest)))
  1167.       ((or (string= (first e) type)
  1168.        (null rest))
  1169.        (if (string= (first e) type)
  1170.        (second e)
  1171.        nil))))
  1172.  
  1173. (defun x-view-buffer (name)
  1174.   (let ((buffer (get-buffer name)))
  1175.     (if (null buffer)
  1176.     (generate-new-buffer name)
  1177.     (let ((proc (get-buffer-process buffer)))
  1178.       (if (and proc
  1179.            (eq (process-status proc) 'run))
  1180.           (progn 
  1181.         (message "Already viewing this file!")
  1182.         nil)
  1183.           buffer)))))
  1184.  
  1185. (defun view-sentinel (proc msg)
  1186.   (cond ((null (buffer-name (process-buffer proc)))
  1187.      ;; buffer killed
  1188.      (set-process-buffer proc nil))
  1189.     (t 
  1190.       (let ((b (current-buffer)))
  1191.         (set-buffer (process-buffer proc))
  1192.         (goto-char (point-max))
  1193.         (insert "Done.\n")
  1194.         (set-buffer b)))))
  1195.  
  1196. (defun x-view-file (fname type)
  1197.   (let* ((viewer
  1198.       (wais-find-viewer type))
  1199.      (buffer (x-view-buffer (concat "*xview-" name)))
  1200.      view-process
  1201.      (b (current-buffer))
  1202.      (command (format "%s %s;/bin/rm %s" viewer fname fname)))
  1203.     (if viewer
  1204.     (if buffer
  1205.         (progn
  1206.           (set-buffer buffer)
  1207.           (make-variable-buffer-local 'wais-document)
  1208.           (setq wais-document 0)
  1209.           (erase-buffer)
  1210.           (insert command "\n")
  1211.           (goto-char (point-max))
  1212.           (set-buffer b)
  1213.           (setq view-process
  1214.             (start-process
  1215.               fname buffer
  1216.               "csh"
  1217.               "-fc" command))
  1218.           (set-process-sentinel view-process 'view-sentinel)
  1219.           buffer)
  1220.         (get-buffer (concat "*xview-" name)))
  1221.     (message "unable to view %s, can't find viewer for type: %s" fname type))))
  1222.  
  1223. (defun find-doc-buffer (docid)
  1224.   (do* ((buffers (buffer-list) (cdr buffers))
  1225.     (buff (car buffers) (car buffers)))
  1226.        ((or (null buffers)
  1227.         (and buff
  1228.          (equal docid
  1229.             (save-excursion
  1230.               (set-buffer buff)
  1231.               wais-document))))
  1232.     (if buffers
  1233.         buff nil))))
  1234.  
  1235. (defun fix-wais-name (name)
  1236.   "Replace TABS in NAME with Space so buffer-select works."
  1237.   (dotimes (i (length name))
  1238.     (if (or (= (aref name i) ?    )
  1239.         (= (aref name i) ? ))
  1240.     (setf (aref name i) ?_)))
  1241.   name)
  1242.  
  1243. (defun edit-document (filename document-number)
  1244.   (let ((buff (current-buffer))
  1245.     (result t))
  1246.     (condition-case e
  1247.      (let* ((q current-question)
  1248.         (f current-question-filename)
  1249.         (n question-name)
  1250.         (wais-string (concat "(:question :result-documents ( "
  1251.                      (get-resdoc document-number
  1252.                          current-question-filename)
  1253.                      " ) )
  1254. "))
  1255.         (name (if *wais-multiple-document-buffers*
  1256.               (fix-wais-name (second (nth (1- document-number)
  1257.                               headlines)))
  1258.               *wais-document-buffer*))
  1259.         (document (get-document (nth (1- document-number)
  1260.                          (get-resdocs q))))
  1261.         (buffer (find-doc-buffer document))
  1262.         (lines headlines)
  1263.         (type (type-from-number q document-number))
  1264.         (best-line (best-line-from-number q document-number))
  1265.         (size (second (member ':number-of-bytes
  1266.                       (get-document (nth (1- document-number)
  1267.                              (get-resdocs q)))))))
  1268.        (if (plusp size)
  1269.            (if (and buffer *wais-multiple-document-buffers*)
  1270.            (progn
  1271.              (when wais-split
  1272.                (setq wais-split nil)
  1273.                (split-window (get-buffer-window (current-buffer))
  1274.                      *wais-document-display-size*))
  1275.              (other-window 1)
  1276.              (switch-to-buffer buffer)
  1277.              (other-window -1))
  1278.            (progn
  1279.              (message "Retrieving Document (%s characters)..." size)
  1280.              (wais-find-process)
  1281.              (set-buffer *wais-receiving-buffer*)
  1282.              (erase-buffer)
  1283.              (process-send-string (wais-find-process) wais-string)
  1284.              (accept-process-output *wais-process*)
  1285.              (if (not (eq (process-status *wais-process*) 'run))
  1286.              (error "WAIS process died. Look in buffer %s for clues."
  1287.                 *wais-receiving-buffer*))
  1288.              (while (and result
  1289.                  (not (save-excursion
  1290.                     (goto-char (point-min))
  1291.                     (search-forward "Waisq: Ready for next question." nil t))))
  1292.                ;; check to see if we've got an bad connection
  1293.                (goto-char (point-min))
  1294.                (if (or (save-excursion
  1295.                  (search-forward "Connection refused"
  1296.                          (save-excursion
  1297.                            (if (search-forward "done." nil t)
  1298.                                (point)))
  1299.                          t))
  1300.                    (save-excursion
  1301.                  (search-forward "bad connection"
  1302.                          (save-excursion
  1303.                            (if (search-forward "done." nil t)
  1304.                                (point)))
  1305.                          t)))
  1306.                (progn
  1307.                  (setq result nil)
  1308.                  (show-dialog t 4 "Looks like a bad connection.")
  1309.                  (top-level)))
  1310.                (if (save-excursion
  1311.                  (re-search-forward "[^\\]Code: [a-zA-Z0-9][a-zA-Z0-9],"
  1312.                          (save-excursion
  1313.                            (if (search-forward "done." nil t)
  1314.                            (point)))
  1315.                          t))
  1316.                (progn
  1317.                  (show-dialog t 4 "Diagnostic Error")
  1318.                  (top-level)))
  1319.                (accept-process-output *wais-process*)
  1320.                (if (not (eq (process-status *wais-process*) 'run))
  1321.                (error "WAIS process died. Look in buffer %s for clues."
  1322.                   *wais-receiving-buffer*)))
  1323.              (if result
  1324.              (save-excursion
  1325.                (goto-char (point-min))
  1326.                (save-excursion
  1327.                  (let* ((end-string "Waisq: Ready for next question.")
  1328.                     (size (progn
  1329.                         (search-forward end-string)
  1330.                         (forward-char (- (1+ (length end-string))))
  1331.                         (point))))
  1332.                    (message "Received %d bytes...done." size)
  1333.                    (setq wais-string
  1334.                      (buffer-substring
  1335.                        (point-min)
  1336.                        size))
  1337.                    (switch-to-buffer (if *wais-multiple-document-buffers*
  1338.                              (generate-new-buffer name)
  1339.                              name))
  1340.                    (setq name (buffer-name))
  1341.                    (setq buffer-read-only nil)
  1342.                    (waisd-mode)
  1343.                    (setq wais-document (get-document (nth (1- document-number)
  1344.                                       (get-resdocs q))))
  1345.                    (setq current-question q)
  1346.                    (setq current-question-filename f)
  1347.                    (setq question-name n)
  1348.                    (erase-buffer)
  1349.                    (setq wais-best-line best-line)
  1350.                    (insert wais-string)
  1351.                    (goto-char (point-min))
  1352.                    (cond ((and type (string= type "WSRC"))
  1353.                       (setq default-directory *wais-source-directory*))
  1354.                      ((and type
  1355.                        (not (string= type "TEXT"))
  1356.                        (not (string= type "WCAT")))
  1357.                       (if (getenv "DISPLAY")
  1358.                       (let ((buff (current-buffer))
  1359.                         (fname  (format "%s%s"
  1360.                                 *wais-document-directory*
  1361.                                 (get-filename name))))
  1362.                         (set-visited-file-name fname)
  1363.                         (set-buffer-modified-p t)
  1364.                         (let ((require-final-newline nil))
  1365.                           (save-buffer 0))
  1366.                         (setq name (x-view-file fname type))
  1367.                         (wais-redisplay-internal)
  1368.                         (kill-buffer buff))
  1369.                       (progn
  1370.                         (setq default-directory *wais-document-directory*)
  1371.                         (message "Got a %s document I can't display." type))))
  1372.                      (t (setq default-directory *wais-document-directory*)
  1373.                     (goto-char (point-min))
  1374.                     (if (rmail-p (current-buffer))
  1375.                         (wais-rmail-show-message 1))
  1376.                     (setq buffer-read-only t)))))
  1377.                (switch-to-buffer buff)
  1378.                (progn    ;unless (and (or (string= type "GIF")
  1379.                     ;    (string= type "TIFF"))
  1380.                     ;   (getenv "DISPLAY"))
  1381.                  (when wais-split
  1382.                    (setq wais-split nil)
  1383.                    (split-window (get-buffer-window (current-buffer))
  1384.                          *wais-document-display-size*))
  1385.                  (other-window 1)
  1386.                  (switch-to-buffer name)
  1387.                  (other-window -1)))
  1388.              (show-dialog t 4 "Error retrieving Document"))))
  1389.            (message "Empty Document, nothing to retrieve.")))
  1390.        (errors
  1391.      (switch-to-buffer buff)
  1392.      (wais-redisplay-internal)
  1393.      (show-dialog t 6 "Something wrong with retrieval."))
  1394.        (quit
  1395.      (switch-to-buffer buff)
  1396.      (wais-redisplay-internal)
  1397.      (message "Abort Retrieval!")
  1398.      (unless *debug*
  1399.        (kill-buffer *wais-receiving-buffer*))))
  1400.     (switch-to-buffer buff)))
  1401.  
  1402. (defun resdoc-from-docret (docret)
  1403.   (let* ((b (current-buffer))
  1404.      (c (get-buffer-create "* wais-temp *"))
  1405.      q)
  1406.     (set-buffer c)
  1407.     (erase-buffer)
  1408.     (insert docret)
  1409.     (goto-char (point-min))
  1410.     (quiet-replace-string "#(" "(")
  1411.     (goto-char (point-min))
  1412.     (setq q (read c))
  1413.     (kill-buffer c)
  1414.     (set-buffer b)
  1415.     (first (get-resdocs q))))
  1416.  
  1417. (defun wais-edit-next-resdoc ()
  1418.   "Edit the document cardinally after this document"
  1419.   (interactive)
  1420.   (edit-next-or-previous-document current-question-filename
  1421.                   (current-line) t))
  1422.  
  1423. (defun wais-edit-previous-resdoc ()
  1424.   "Edit the document cardinally after this document"
  1425.   (interactive)
  1426.   (edit-next-or-previous-document current-question-filename
  1427.                   (current-line) nil))
  1428.  
  1429. ;;; this mostly works.  It cannot as yet be called from a keystroke.
  1430. ;;; Need to resolve docid so it doesn't retrieve the document multiple times 
  1431. ;;; if it's alread in a buffer.  That's pretty close!  I think I'll put it
  1432. ;;; on a key. How about + an -!
  1433.  
  1434. (defun edit-next-or-previous-document (filename document-number nextp)
  1435.   (let ((buff (current-buffer))
  1436.     (result t))
  1437.     (condition-case e
  1438.      (let* ((q current-question)
  1439.         (f current-question-filename)
  1440.         (n question-name)
  1441.         (resdoc (next-or-prev-doc
  1442.               (get-resdoc document-number
  1443.                       current-question-filename)
  1444.               nextp))
  1445.         (wais-string (concat "(:question :seed-words \"foo\" :relevant-documents ( "
  1446.                      resdoc
  1447.                      " ) :sources ( "
  1448.                      (format "%s ) " (first (get-sources current-question))) " )
  1449. ")))
  1450.        (progn
  1451.          (wais-find-process)
  1452.          (set-buffer *wais-receiving-buffer*)
  1453.          (erase-buffer)
  1454.          (process-send-string (wais-find-process) wais-string)
  1455.          (accept-process-output *wais-process*)
  1456.          (if (not (eq (process-status *wais-process*) 'run))
  1457.          (error "WAIS process died. Look in buffer %s for clues."
  1458.             *wais-receiving-buffer*))
  1459.          (while (and result
  1460.              (not (save-excursion
  1461.                 (goto-char (point-min))
  1462.                 (search-forward "Waisq: Ready for next question." nil t))))
  1463.            ;; check to see if we've got an bad connection
  1464.            (goto-char (point-min))
  1465.            (if (or (save-excursion
  1466.              (search-forward "Connection refused"
  1467.                      (save-excursion
  1468.                        (if (search-forward "Found" nil t)
  1469.                            (point)))
  1470.                      t))
  1471.                (save-excursion
  1472.              (search-forward "bad connection"
  1473.                      (save-excursion
  1474.                        (if (search-forward "Found" nil t)
  1475.                            (point)))
  1476.                      t)))
  1477.            (progn
  1478.              (setq result nil)
  1479.              (show-dialog t 4 "Looks like a bad connection.")
  1480.              (top-level)))
  1481.            (if (save-excursion
  1482.            (re-search-forward "[^\\]Code: [a-zA-Z0-9][a-zA-Z0-9],"
  1483.                      (save-excursion
  1484.                        (if (search-forward "Found" nil t)
  1485.                        (point)))
  1486.                      t))
  1487.            (progn
  1488.              (show-dialog t 4 "Diagnostic Error")
  1489.              (top-level)))
  1490.            (accept-process-output *wais-process*)
  1491.            (if (not (eq (process-status *wais-process*) 'run))
  1492.            (error "WAIS process died. Look in buffer %s for clues."
  1493.               *wais-receiving-buffer*)))
  1494.          (if result
  1495.          (save-excursion
  1496.            (goto-char (point-min))
  1497.            (save-excursion
  1498.              (let ((size (1- (progn
  1499.                        (goto-char (point-min))
  1500.                        (search-forward "Found")
  1501.                        (next-line 1)
  1502.                        (beginning-of-line)
  1503.                        (point)))))
  1504.                (setq wais-string
  1505.                  (buffer-substring
  1506.                    (point)
  1507.                    (progn
  1508.                  (search-forward "Waisq: Ready for next question.")
  1509.                  (forward-char -31)
  1510.                  (point)))))))))
  1511.        (let* ((docid (resdoc-from-docret wais-string))
  1512.           (document (get-document docid))
  1513.           (name (if *wais-multiple-document-buffers*
  1514.                 (fix-wais-name (get-headline document))
  1515.                 *wais-document-buffer*))
  1516.           (buffer (find-doc-buffer document))
  1517.           (type (get-type docid))
  1518.           (best-line (best-line-from-number q document-number))
  1519.           (size (get-size document)))
  1520.          (if (and buffer *wais-multiple-document-buffers*)
  1521.          (progn
  1522.            (when wais-split
  1523.              (setq wais-split nil)
  1524.              (split-window (get-buffer-window (current-buffer))
  1525.                    *wais-document-display-size*))
  1526.            (other-window 1)
  1527.            (switch-to-buffer buffer)
  1528.            (other-window -1))
  1529.          (progn
  1530.            (setq wais-string
  1531.              (format "(:question :result-documents ( %s ) ) "
  1532.                  docid))
  1533.            (wais-find-process)
  1534.            (set-buffer *wais-receiving-buffer*)
  1535.            (erase-buffer)
  1536.            (process-send-string (wais-find-process) wais-string)
  1537.            (accept-process-output *wais-process*)
  1538.            (if (not (eq (process-status *wais-process*) 'run))
  1539.                (error "WAIS process died. Look in buffer %s for clues."
  1540.                   *wais-receiving-buffer*))
  1541.            (while (and result
  1542.                    (not (save-excursion
  1543.                       (goto-char (point-min))
  1544.                       (search-forward "Waisq: Ready for next question." nil t))))
  1545.              ;; check to see if we've got an bad connection
  1546.              (goto-char (point-min))
  1547.              (if (or (save-excursion
  1548.                    (search-forward "Connection refused"
  1549.                            (save-excursion
  1550.                          (if (search-forward "done." nil t)
  1551.                              (point)))
  1552.                            t))
  1553.                  (save-excursion
  1554.                    (search-forward "bad connection"
  1555.                            (save-excursion
  1556.                          (if (search-forward "done." nil t)
  1557.                              (point)))
  1558.                            t)))
  1559.              (progn
  1560.                (setq result nil)
  1561.                (show-dialog t 4 "Looks like a bad connection.")
  1562.                (top-level)))
  1563.              (if (save-excursion
  1564.                (re-search-forward "[^\\]Code: [a-zA-Z0-9][a-zA-Z0-9],"
  1565.                           (save-excursion
  1566.                         (if (search-forward "done." nil t)
  1567.                             (point)))
  1568.                           t))
  1569.              (progn
  1570.                (show-dialog t 4 "Diagnostic Error")
  1571.                (top-level)))
  1572.              (accept-process-output *wais-process*)
  1573.              (if (not (eq (process-status *wais-process*) 'run))
  1574.              (error "WAIS process died. Look in buffer %s for clues."
  1575.                 *wais-receiving-buffer*)))
  1576.            (if result
  1577.                (save-excursion
  1578.              (goto-char (point-min))
  1579.              (save-excursion
  1580.                (let ((size (1- (progn
  1581.                          (goto-char (point-min))
  1582.                          (search-forward "done.")
  1583.                          (forward-char 1)
  1584.                          (point)))))
  1585.                  (save-excursion
  1586.                    (word-search-backward "Received")
  1587.                    (message "%s...done." (buffer-substring (point) (- size 7))))
  1588.                  (setq wais-string
  1589.                    (buffer-substring
  1590.                      (point)
  1591.                      (progn
  1592.                        (search-forward "Waisq: Ready for next question.")
  1593.                        (forward-char -31)
  1594.                        (point))))))
  1595.              (switch-to-buffer (if *wais-multiple-document-buffers*
  1596.                            (generate-new-buffer name)
  1597.                            name))
  1598.              (setq name (buffer-name))
  1599.              (setq buffer-read-only nil)
  1600.              (waisd-mode)
  1601.              (setq wais-document (get-document docid))
  1602.              (setq current-question q)
  1603.              (setq current-question-filename f)
  1604.              (setq question-name n)
  1605.              (erase-buffer)
  1606.              (setq wais-best-line best-line)
  1607.              (insert wais-string)
  1608.              (goto-char (point-min))
  1609.              (cond ((and type (string= type "WSRC"))
  1610.                 (setq default-directory *wais-source-directory*))
  1611.                    ((and type
  1612.                      (not (string= type "TEXT"))
  1613.                      (not (string= type "WCAT")))
  1614.                 (if (getenv "DISPLAY")
  1615.                     (let ((buff (current-buffer))
  1616.                       (fname  (format "%s%s"
  1617.                               *wais-document-directory*
  1618.                               (get-filename name))))
  1619.                       (set-visited-file-name fname)
  1620.                       (set-buffer-modified-p t)
  1621.                       (let ((require-final-newline nil))
  1622.                     (save-buffer 0))
  1623.                       (setq name (x-view-file fname type))
  1624.                       (wais-redisplay-internal)
  1625.                       (kill-buffer buff))
  1626.                     (progn
  1627.                       (setq default-directory *wais-document-directory*)
  1628.                       (message "Got a %s document I can't display." type))))
  1629.                    (t (setq default-directory *wais-document-directory*)
  1630.                   (goto-char (point-min))
  1631.                   (if (rmail-p (current-buffer))
  1632.                       (wais-rmail-show-message 1))
  1633.                   (setq buffer-read-only t)))
  1634.              (switch-to-buffer buff)
  1635.              (progn
  1636.                (when wais-split
  1637.                  (setq wais-split nil)
  1638.                  (split-window (get-buffer-window (current-buffer))
  1639.                        *wais-document-display-size*))
  1640.                (other-window 1)
  1641.                (switch-to-buffer name)
  1642.                (other-window -1)))
  1643.                (show-dialog t 4 "Error retrieving Document"))))))
  1644.        (errors
  1645.      (switch-to-buffer buff)
  1646.      (wais-redisplay-internal)
  1647.      (show-dialog t 6 "Something wrong with retrieval."))
  1648.        (quit
  1649.      (switch-to-buffer buff)
  1650.      (wais-redisplay-internal)
  1651.      (message "Abort Retrieval!")
  1652.      (unless *debug*
  1653.        (kill-buffer *wais-receiving-buffer*))))
  1654.     (switch-to-buffer buff)))
  1655.  
  1656. (defun waisd-best-line ()
  1657.   (interactive)
  1658.   (if (and (boundp 'wais-best-line)
  1659.        wais-best-line)
  1660.       (goto-line wais-best-line)))
  1661.  
  1662. (defun waisq-best-line ()
  1663.   (interactive)
  1664.   (other-window 1)
  1665.   (waisd-best-line)
  1666.   (other-window -1))
  1667.  
  1668. (defun wais-add-section ()
  1669.   "Add the current region as a section to the document"
  1670.   (interactive)
  1671.   (let ((here (point))
  1672.     (there (mark)))
  1673.     (save-window-excursion
  1674.       (let ((start-line (current-line))
  1675.         (end-line (save-excursion
  1676.             (goto-char there)
  1677.             (current-line))))
  1678.     (if (> start-line end-line)
  1679.         (let ((temp end-line))
  1680.           (setq end-line start-line)
  1681.           (setq start-line temp)))
  1682.     (wais-add-fragment wais-document
  1683.                current-question-filename question-name
  1684.                (1- start-line) (1- end-line))))))
  1685.  
  1686. (defun insert-parts (first second)
  1687.   (if (and first
  1688.        (listp first))
  1689.       (insert-struct first)
  1690.       (insert (format "%s " first)))
  1691.   (if (and second
  1692.        (listp second)
  1693.        (not (eq (first second) ':any)))
  1694.       (progn (newline 1)
  1695.          (insert-struct second))
  1696.       (if (stringp second)
  1697.       (progn
  1698.         (insert "\"")
  1699.         (dotimes (i (length second))
  1700.           (if (= (aref second i) ?\")
  1701.           (insert "\\\"")
  1702.         (insert (aref second i))))
  1703.         (insert "\""))
  1704.       (if (and (listp second)
  1705.            (eq (first second) ':any))
  1706.           (insert-any second)
  1707.           (insert (format "%s" second))))))
  1708.  
  1709. (defun insert-any (any)
  1710.   (insert (format "(%s %s %d %s " 
  1711.           (first any) (second any) (third any) (fourth any)))
  1712.   (insert "#( ")
  1713.   (dolist (n (fifth any))
  1714.     (insert (format "%d " n)))
  1715.   (insert "
  1716. )
  1717. )"))
  1718.  
  1719. (defun insert-struct (struct)
  1720.   (insert "(")
  1721.   (if (and (first struct)
  1722.        (listp (first struct)))
  1723.       (insert-struct (first struct))
  1724.       (insert (format "%s" (first struct)) "
  1725. "))
  1726.     (do ((first (second struct) (first rest))
  1727.      (second (third struct) (second rest))
  1728.      (rest (cdddr struct) (cddr rest)))
  1729.     ((null rest)
  1730.      (insert-parts first second))
  1731.       (insert-parts first second)
  1732.       (newline 1))
  1733.     (insert "
  1734. )"))
  1735.  
  1736. (defun wais-add-fragment (doc file name start end)
  1737.   (update-keywords name)
  1738.   (let ((reldoc (make-doc-fragment doc start end)))
  1739.     (save-excursion
  1740.       (find-file file)
  1741.       (goto-char (point-min))
  1742.       (search-forward ":result-documents")
  1743.       (goto-char (point-min))
  1744.       (search-forward ":relevant-documents")
  1745.       (search-forward "( ")
  1746.       (save-excursion
  1747.     (insert-struct reldoc))
  1748.       (indent-sexp)
  1749.       (let ((require-final-newline nil))
  1750.     (save-buffer 0))
  1751.       (kill-buffer (current-buffer))
  1752.       (display-question name))))
  1753.  
  1754. (defun make-doc-fragment (doc start end)
  1755.   (list ':document-id
  1756.     ':start (list ':fragment ':line-pos start)
  1757.     ':end (list ':fragment ':line-pos end)
  1758.     ':document doc))
  1759.  
  1760. (defun wais-delete-all-documents ()
  1761.   "Delete all WAIS DOC buffers"
  1762.   (interactive)
  1763.   (let ((current-buffer (current-buffer)))
  1764.     (dolist (buf (buffer-list))
  1765.       (set-buffer buf)
  1766.       (when (and (boundp 'wais-document)
  1767.          wais-document)
  1768.     (kill-buffer buf)))))
  1769.  
  1770. (defun bury-doc-buffers ()
  1771.   (let ((current-buffer (current-buffer)))
  1772.     (dolist (buf (buffer-list))
  1773.       (set-buffer buf)
  1774.       (when (and (boundp 'wais-document)
  1775.          wais-document)
  1776.     (switch-to-buffer buf)
  1777.     (bury-buffer buf)))))
  1778.  
  1779. (defun wais-scroll-msg-up (&optional dist)
  1780.   "Scroll other window forward."
  1781.   (interactive "P")
  1782.   (unless wais-split
  1783.     (condition-case foo
  1784.      (scroll-other-window dist)
  1785.        (error (message "Bottom of buffer")))))
  1786.  
  1787. (defun wais-scroll-msg-down (&optional dist)
  1788.   "Scroll other window backward."
  1789.   (interactive "P")
  1790.   (unless wais-split
  1791.     (condition-case foo
  1792.      (scroll-other-window
  1793.        (cond ((eq dist '-) nil)
  1794.          ((null dist) '-)
  1795.          (t (- (prefix-numeric-value dist)))))
  1796.        (error (message "Top of buffer")))))
  1797.  
  1798. (defvar *rmail-header-regex* "*** EOOH ***")
  1799.  
  1800. (defun rmail-p (buffer)
  1801.   (save-excursion
  1802.     (switch-to-buffer buffer)
  1803.     (condition-case rmail-p
  1804.      (re-search-forward *rmail-header-regex*)
  1805.        (error nil))))
  1806.  
  1807. (defun wais-rmail-show-message (n)
  1808.   "Show message in wais."
  1809.   (interactive "p")
  1810.   (widen)
  1811.   (let (blurb)
  1812.     (let ((beg (point-min))
  1813.       (end (point-max)))
  1814.       (goto-char beg)
  1815.       (forward-line 1)
  1816.       (if (= (following-char) ?0)
  1817.       (progn
  1818.         (rmail-reformat-message beg end)
  1819.         (rmail-set-attribute "unseen" nil))
  1820.       (search-forward "\n*** EOOH ***\n" end t)
  1821.       (narrow-to-region (point) end))
  1822.       (goto-char (point-min))
  1823.                     ;    (rmail-display-labels)
  1824.                     ;    (run-hooks 'rmail-show-message-hook)
  1825.       (if blurb
  1826.       (message blurb)))))
  1827.  
  1828. (defun waisq (&optional name)
  1829.   "Edit a Wais Question"
  1830.   (interactive "sEdit an existing question named: ")
  1831.   (display-question name))
  1832.  
  1833. ;; question Menu mode is suitable only for specially formatted data.
  1834. (put 'question-menu-mode 'mode-class 'special)
  1835.  
  1836. (defun question-menu-mode ()
  1837.   "Major mode for editing a list of questions.
  1838.    Each line describes one of the questions in Emacs.
  1839.    Letters do not insert themselves; instead, they are commands.
  1840.    q (or space) -- select question of line point is on.
  1841.    Precisely,\\{question-menu-mode-map}"
  1842.   (kill-all-local-variables)
  1843.   (use-local-map question-menu-mode-map)
  1844.   (setq truncate-lines *waisq-truncate-mode*)
  1845.   (setq question-read-only t)
  1846.   (setq major-mode 'question-menu-mode)
  1847.   (setq mode-name "Question Menu")
  1848.   (run-hooks 'question-menu-mode-hook))
  1849.  
  1850. (defun question-menu-select ()
  1851.   "Select question described by this line of question menu."
  1852.   (interactive)
  1853.   (let* ((path (question-menu-get-path)))
  1854.     (if (null path)
  1855.     (progn
  1856.       (message "No question selected")
  1857.       (bury-buffer))
  1858.     (progn
  1859.       (set-buffer-modified-p nil)
  1860.       (switch-to-buffer (other-buffer))
  1861.       (bury-buffer question-menu-buffer-name)
  1862.       (message "Fetching Question %s..." path)
  1863.       (display-question path)
  1864.       (message "Fetching Question %s...done." path)))))
  1865.  
  1866. (defun question-menu-get-path ()
  1867.   "returns the pathname on this line"
  1868.   (if (= (current-line) 1)
  1869.       nil
  1870.       (progn
  1871.     (beginning-of-line)
  1872.     (let ((begin (point)))
  1873.       (end-of-line)
  1874.       (let ((answer (buffer-substring begin (point))))
  1875.         (beginning-of-line)
  1876.         (cond ((or (= 0 (length answer))
  1877.                (char-equal (aref "<" 0) (aref answer 0)))
  1878.            (message "No Question on this line")
  1879.            nil)
  1880.           (t answer)))))))
  1881.  
  1882. (defun all-questions ()
  1883.   "returns a list of the names of questions.  This should look into the 
  1884.       question and pull out the name, but that is not in the question struct yet."
  1885.   (let ((answer ())
  1886.     last-char)
  1887.     (let ((directory *wais-question-directory*))
  1888.       (dolist (file (directory-files directory))
  1889.     (setq last-char (aref file (1- (length file))))
  1890.     (if (and (not (file-directory-p (concat directory file)))
  1891.          (not (member file answer))
  1892.          (not (or (string= file ".")
  1893.               (string= file "..")
  1894.               (eq last-char ?~)
  1895.               (eq last-char ?#))))
  1896.         (push file answer))))
  1897.     (nreverse answer)))
  1898.  
  1899. (defun wais-select-question ()
  1900.   "Make a menu of questions so you can select one.  
  1901.    Type ? after invocation to get help on commands available.
  1902.    Type q immediately to make the question menu go away."
  1903.   (interactive)
  1904.   (let ((questions (all-questions)))
  1905.     (if questions
  1906.     (progn
  1907.       (delete-other-windows)
  1908.       (switch-to-buffer "*Question List*")  
  1909.       (question-menu-mode)
  1910.       (setq buffer-read-only nil)
  1911.       (erase-buffer)
  1912.       (insert "<<Select a question with <space> or 'q'>>\n")
  1913.       (dolist (question questions)
  1914.         (insert question)
  1915.         (insert "\n"))
  1916.       (delete-char -1)
  1917.       (goto-char (point-min))
  1918.       (forward-line 1)
  1919.       (setq buffer-read-only t)
  1920.       (message
  1921.         "Commands: <space>, q, ? for help.")
  1922.       nil)
  1923.     (when (yes-or-no-p
  1924.         "You have no questions.  would you like to create one? ")
  1925.       (wais-create-question)))))
  1926.  
  1927. (defvar question-menu-mode-map nil "")
  1928. (defvar question-menu-buffer-name "*Question List*")
  1929.  
  1930. (defun setup-question-mode-map ()
  1931.   (suppress-keymap question-menu-mode-map t)
  1932.   (define-key question-menu-mode-map "q" 'question-menu-select)
  1933.   (define-key question-menu-mode-map "s" 'question-menu-select)
  1934.   (define-key question-menu-mode-map " " 'question-menu-select)
  1935.   (define-key question-menu-mode-map "n" 'next-line)
  1936.   (define-key question-menu-mode-map "p" 'previous-line)
  1937.   (define-key question-menu-mode-map "?" 'describe-mode))
  1938.  
  1939. (if question-menu-mode-map
  1940.     ()
  1941.     (progn
  1942.       (setq question-menu-mode-map (make-keymap))
  1943.       (setup-question-mode-map)))
  1944.  
  1945. (defun wais-novice ()
  1946.   "Create and run the 'Quick' novice question, and pop up
  1947. the novice Help"
  1948.   (interactive)
  1949.   (make-wais-novice-question))
  1950.  
  1951. (defun make-wais-novice-question ()
  1952.   (wais-create-question "Quick" "?" "directory-of-servers.src")
  1953.   (wais-query)
  1954.   (show-novice-wais-help))
  1955.  
  1956. (defvar *wais-novice-string* 
  1957. "First, I've created a 'Quick' question for you, and hopefully it ran.  You
  1958. now see a typical WAIS display.  Let me first tell you that you can scroll
  1959. this window by pressing the space bar and the Delete key, in case you can't
  1960. see it all.
  1961.  
  1962. There are five parts to this display:
  1963. 1. the Search words
  1964. 2. the Sources to search
  1965. 3. some documents that might be similar to your intended document
  1966. 4. the Resulting documents from the search
  1967. 5. a document, in this case, this message.
  1968.  
  1969. You can now use this Question to ask further questions, or you might wish
  1970. to create some questions of your own (they don't all have to be the 'Quick'
  1971. question).
  1972.  
  1973. The most useful keystrokes for using WAISQ mode are (case is important!):
  1974.  
  1975. <space>:  scroll the text in the other window up
  1976.   <del>:  scroll the text in the other window down
  1977.       k:  switches you to the search word window
  1978.   e,f,v:  view the current result document in a window like this one.
  1979.       a:  add the current document to the relevant documents list
  1980.       d:  delete all the relevant documents
  1981.       A:  capital A adds a new source
  1982.       D:  captial D deletes all the sources.
  1983.   g,RET:  perform the query.
  1984.     C-l:  rebuild the display, removing the document view window.
  1985.       s:  select a new Question
  1986.       q:  quit out of this question, and bury it.
  1987.       Q:  capital Q quits out of this question, and kill all its buffers.
  1988.       ?:  describe waisq-mode shows all new keystrokes associated with
  1989.           WAISQ mode.
  1990.  
  1991. You really shouldn't have to use C-x o to switch to other windows, but if
  1992. you do, you should go back to the result-documents window and press C-l to
  1993. rebuild the display.")
  1994.  
  1995. (defun show-novice-wais-help ()
  1996.   "Show something useful for a new user of WAIS"
  1997.   (interactive)
  1998.   (wais-redisplay-internal)
  1999.   (when wais-split
  2000.     (setq wais-split nil)
  2001.     (split-window (get-buffer-window (current-buffer))*wais-document-display-size*))
  2002.   (other-window 1)
  2003.   (switch-to-buffer (get-buffer-create "*WAIS Novice Help*"))
  2004.   (erase-buffer)
  2005.   (insert *wais-novice-string*)
  2006.   (goto-char (point-min))
  2007.   (other-window -1))
  2008.  
  2009. (defun wais-create-question (&optional name keywords source)
  2010.   "Create a new Question named NAME"
  2011.   (interactive)
  2012.   (let ((new (check-init-directories)))
  2013.     (unless name
  2014.       (setq name (read-input "Create a new question named: ")))
  2015.     (unless keywords
  2016.       (setq keywords ""))
  2017.     (unless source
  2018.       (setq source (get-source-name)))
  2019.     (let ((file (expand-file-name
  2020.           (concat *wais-question-directory*
  2021.               name))))
  2022.       (create-question-internal file keywords source)
  2023.       (display-question name)
  2024.       (wais-goto-keywords))
  2025.     (if new
  2026.     (message "For more information, try M-x wais-novice"))))
  2027.  
  2028. (defun create-question-internal (file keywords source)
  2029.   (find-file file)
  2030.   (erase-buffer)
  2031.   (insert  "(:question 
  2032.        :version  2 
  2033.        :seed-words \"" keywords "\"
  2034.        :sources 
  2035.        (  (:source-id 
  2036.        :filename \"" source "\"
  2037.        ) 
  2038.      )
  2039.        )
  2040. ")
  2041.   (let ((require-final-newline nil))
  2042.     (save-buffer 0))
  2043.   (kill-buffer (current-buffer)))
  2044.  
  2045. (defun find-documents-on ()
  2046.   "Obsolete.  Use M-x wais or M-x wais-create-question"
  2047.   (interactive)
  2048.   (message "Obsolete.  Use M-x wais or M-x wais-create-question"))
  2049.  
  2050. (defun delete-string ()
  2051.   (search-forward "\"")
  2052.   (let ((here (1- (point))))
  2053.     (search-forward "\"")
  2054.     (delete-char (- here (point)))))
  2055.  
  2056. (defun wais-goto-keywords ()
  2057.   "Go to the keyword window for this question"
  2058.   (interactive)
  2059.   (wais-redisplay-internal)
  2060.   (other-window -3))
  2061.  
  2062. (defun wais-replace-keywords (&optional keys)
  2063.   "Replace the 'Find documents on' words in the current Question"
  2064.   (interactive "sFind documents on: ")
  2065.   (if (> (length keys) 4999)
  2066.       (error "Keys longer than 5000 characters.  I Can't handle that.")
  2067.       (let ((file current-question-filename)
  2068.         (name question-name))
  2069.     (find-file file)
  2070.     (goto-char (point-min))
  2071.     (search-forward ":seed-words")
  2072.     (delete-string)
  2073.     (insert " \"" keys "\"")
  2074.     (let ((require-final-newline nil))
  2075.       (save-buffer 0))
  2076.     (kill-buffer (current-buffer)))))
  2077.  
  2078. (defun wais-delete-sources ()
  2079.   "Delete all sources from this question"
  2080.   (interactive)
  2081.   (let ((doc (current-line))
  2082.     (file current-question-filename)
  2083.     (name question-name))
  2084.     (update-keywords name)
  2085.     (find-file file)
  2086.     (emacs-lisp-mode)
  2087.     (goto-char (point-min))
  2088.     (search-forward ":sources")
  2089.     (search-forward "(")
  2090.     (backward-char 1)
  2091.     (let ((loc (point)))
  2092.       (forward-sexp 1)
  2093.       (setq loc (point))
  2094.       (forward-sexp -1)
  2095.       (delete-char (- loc (point)))
  2096.       (insert "(  )")
  2097.       (let ((require-final-newline nil))
  2098.     (save-buffer 0))
  2099.       (kill-buffer (current-buffer))
  2100.       (display-question name current-question-filename)
  2101.       (forward-line (1- doc)))))
  2102.  
  2103.  
  2104. (defun wais-add-source (&optional source)
  2105.   "Add a Source to the current Question"
  2106.   (interactive)
  2107.   (unless source
  2108.     (setq source (get-source-name)))
  2109.   (let ((doc (current-line))
  2110.     (file current-question-filename)
  2111.     (name question-name))
  2112.     (update-keywords name)
  2113.     (find-file file)
  2114.     (goto-char (point-min))
  2115.     (search-forward ":sources")
  2116.     (search-forward "(")
  2117.     (insert "  (:source-id :filename \"" source "\" ) 
  2118. ")
  2119.     (let ((require-final-newline nil))
  2120.       (save-buffer 0))
  2121.     (kill-buffer (current-buffer))
  2122.     (display-question name current-question-filename)
  2123.     (forward-line (1- doc))))
  2124.  
  2125.  
  2126.  
  2127. (defvar *wais-selected-sources* nil
  2128.   "A list of selected sources for a default question")
  2129.  
  2130. ;; source Menu mode is suitable only for specially formatted data.
  2131. (put 'source-menu-mode 'mode-class 'special)
  2132.  
  2133. (defun source-menu-mode ()
  2134.   "Major mode for editing a list of sources.
  2135. Each line describes one of the sources in Emacs.
  2136. Letters do not insert themselves; instead, there are commands.
  2137. q, s, v, or space -- view the source of line point is on.
  2138. Precisely,\\{source-menu-mode-map}"
  2139.   (kill-all-local-variables)
  2140.   (use-local-map source-menu-mode-map)
  2141.   (setq truncate-lines *waisq-truncate-mode*)
  2142.   (setq source-read-only t)
  2143.   (setq major-mode 'source-menu-mode)
  2144.   (setq mode-name "Source Menu")
  2145.   (run-hooks 'source-menu-mode-hook))
  2146.  
  2147. (defun source-menu-view ()
  2148.   "View source described by this line of source menu."
  2149.   (interactive)
  2150.   (let* ((path (source-menu-get-path)))
  2151.     (if (null path)
  2152.     (message "No source selected")
  2153.     (if (file-exists-p (concat *wais-source-directory* path))
  2154.         (view-file (concat *wais-source-directory* path))
  2155.         (if (file-exists-p (concat *common-source-directory* path))
  2156.         (view-file (concat *common-source-directory* path))))))
  2157.   (bury-buffer)
  2158.   (if (eq major-mode 'waisq-mode)
  2159.       (wais-redisplay-internal)))
  2160.  
  2161. (defun source-menu-get-path ()
  2162.   "returns the pathname on this line"
  2163.   (if (= (current-line) 1)
  2164.       nil
  2165.       (progn
  2166.     (beginning-of-line)
  2167.     (let ((begin (point)))
  2168.       (end-of-line)
  2169.       (let ((answer (buffer-substring begin (point))))
  2170.         (beginning-of-line)
  2171.         (cond ((or (= 0 (length answer))
  2172.                (char-equal (aref "<" 0) (aref answer 0)))
  2173.            (message "No Source on this line")
  2174.            nil)
  2175.           (t answer)))))))
  2176.  
  2177. (defun all-sources ()
  2178.   "returns a list of the names of sources.  This should look into the 
  2179.    source and pull out the name, but that is not in the source struct yet."
  2180.   (let ((answer ())
  2181.     last-char)
  2182.     (if (and (stringp *wais-source-directory*)
  2183.          (file-directory-p *wais-source-directory*))
  2184.     (dolist (file (directory-files *wais-source-directory*))
  2185.       (setq last-char (aref file (1- (length file))))
  2186.       (if (and (> (length file) 3)
  2187.            (string= (substring file -4) ".src"))
  2188.           (push (cons file file) answer))))
  2189.     (if (and *common-source-directory*
  2190.          (stringp *common-source-directory*)
  2191.          (not (eq *common-source-directory* *wais-source-directory*))
  2192.          (file-exists-p *common-source-directory*))
  2193.     (dolist (file (directory-files *common-source-directory*))
  2194.       (if (and (> (length file) 3)
  2195.            (string= (substring file -4) ".src"))
  2196.           (push (cons file file) answer))))
  2197.     (unless (null answer)
  2198.       (sort answer '(lambda (a b) (string< (car a) (car b)))))))
  2199.  
  2200. (defun wais-view-source ()
  2201.   "Make a menu of sources so you can select one to view.  
  2202. Type ? after invocation to get help on commands available.
  2203. Type q immediately to make the source menu go away."
  2204.   (interactive)
  2205.   (let ((sources (all-sources)))
  2206.     (if sources
  2207.     (progn
  2208.       (delete-other-windows)
  2209.       (switch-to-buffer "*Source List*")  
  2210.       (source-menu-mode)
  2211.       (setq buffer-read-only nil)
  2212.       (erase-buffer)
  2213.       (insert "<<Select a source with <space> or 'q', view with 'v'>>\n")
  2214.       (dolist (source sources)
  2215.         (insert (car source))
  2216.         (insert "\n"))
  2217.       (delete-char -1)
  2218.       (goto-char (point-min))
  2219.       (forward-line 1)
  2220.       (setq buffer-read-only t)
  2221.       (message
  2222.         "Commands: <space>, q, v or ? for help.")
  2223.       nil)
  2224.     (message "No sources.  Something is wrong - see your site administrator"))))
  2225.  
  2226. (defvar source-menu-mode-map nil "")
  2227. (defvar source-menu-buffer-name "*Source List*")
  2228.  
  2229. (defun setup-source-mode-map ()
  2230.   (suppress-keymap source-menu-mode-map t)
  2231.   (define-key source-menu-mode-map "q" 'source-menu-view)
  2232.   (define-key source-menu-mode-map "s" 'source-menu-view)
  2233.   (define-key source-menu-mode-map " " 'source-menu-view)
  2234.   (define-key source-menu-mode-map "n" 'next-line)
  2235.   (define-key source-menu-mode-map "p" 'previous-line)
  2236.   (define-key source-menu-mode-map "v" 'source-menu-view)
  2237.   (define-key source-menu-mode-map "?" 'describe-mode))
  2238.  
  2239. (if source-menu-mode-map
  2240.     ()
  2241.     (progn
  2242.       (setq source-menu-mode-map (make-keymap))
  2243.       (setup-source-mode-map)))
  2244.  
  2245. (defun get-source-name ()
  2246.   (let ((result "")
  2247.     (sources (all-sources)))
  2248.     (save-window-excursion
  2249.       (delete-other-windows)
  2250.       (if sources
  2251.       (progn
  2252.         (while (string= result "")
  2253.           (setq result
  2254.             (completing-read "Select Source (press ? for a list of sources): "
  2255.                      sources nil t nil)))
  2256.         result)
  2257.       (message
  2258.         "No sources.  Something is wrong - see your site administrator")))))
  2259.  
  2260. (defun source-defined-p (source)
  2261.   (assoc source (all-sources)))
  2262.  
  2263. (defvar index-types '(("groliers" . "groliers")
  2264.               ("mail" . "mail")
  2265.               ("rmail" . "rmail")
  2266.               ("netnews" . "netnews")
  2267.               ("catalog" . "catalog")
  2268.               ("bio" . "bio")
  2269.               ("cmapp" . "cmapp")
  2270.               ("text" . "text")
  2271.               ("para". "para")))
  2272.  
  2273. (defun basename (path)
  2274.   (do ((loc (1- (length path)) (1- loc)))
  2275.       ((or (minusp loc)
  2276.        (eq (aref path loc) ?/))
  2277.        (substring path (1+ loc)))))
  2278.  
  2279. ;;; this will create and index a database
  2280. ;;; but uses local search (no configuration).
  2281.  
  2282. (require 'compile)
  2283.  
  2284. (defun wais-index (command)
  2285.   "Run waisindex-program, with user-specified args, and collect output in a buffer."
  2286.   (interactive "sIndex (with args): ")
  2287.   (compile1 (concat waisindex-program command)
  2288.         "Done" "waisindex"))
  2289.  
  2290. (defun wais-create-source (source)
  2291.   "Create a new Source and a database to go with it"
  2292.   (interactive "sName for this Source: ")
  2293.   (let ((server-name-or-address nil)
  2294.     (port nil))
  2295.     (if (yes-or-no-p "Shall I create the index? ")
  2296.     (let* ((db (read-file-name "File(s) to index (unix wildcards allowed): "))
  2297.            (type (completing-read "Type (press ? for a list of types, default is Text): "
  2298.                       index-types nil t nil))
  2299.            (exportp (yes-or-no-p "Export this Source? "))
  2300.            (index (concat (if exportp
  2301.                   *common-source-directory*
  2302.                   *wais-source-directory*)
  2303.                   source)))
  2304.       (if (string= type "") (setq type "text"))
  2305.       (wais-index (concat (case wais-version
  2306.                 (7 " -i ")
  2307.                 (8 " -d ")
  2308.                 (t " -d "))
  2309.                   index " -t " type " "
  2310.                   (case wais-version
  2311.                 (7 "")
  2312.                 (8 (if exportp
  2313.                        " -export "
  2314.                        ""))
  2315.                 (t ""))
  2316.                   (expand-file-name db))))
  2317.     (progn
  2318.       (setq index (read-file-name "Index for this sources (path prefix, without . suffix): "))
  2319.       (setq server-name-or-address (read-input "On Server: "))
  2320.       (if (not (string= server-name-or-address ""))
  2321.           (setq port (read-input "Using port: ")))
  2322.       (message "Creating source %s, for index %s..." source index)
  2323.       (find-file (concat *wais-source-directory*
  2324.                  (if (string= (substring *wais-source-directory* -1) "/")
  2325.                  ""
  2326.                  "/")
  2327.                  source ".src"))
  2328.       (erase-buffer)
  2329.       (insert "(:source
  2330.    :version  3
  2331.    " (if (and server-name-or-address
  2332.           (not (string= server-name-or-address "")))
  2333.      (concat ":ip-name \"" server-name-or-address "\"
  2334.    ")
  2335.      "")
  2336.    (if (and port
  2337.         (not (string= "" port)))
  2338.        (concat ":tcp-port " port "
  2339.    ")
  2340.        "")
  2341.    ":database-name \"" (expand-file-name index) "\"
  2342.    :cost 0.00
  2343.    :cost-unit :free
  2344.    :description \"Source structure created by GMACS Wais interface, ")
  2345.       (insert-date t)
  2346.       (insert "\"
  2347.    )")
  2348.       (let ((require-final-newline nil))
  2349.         (save-buffer 0))
  2350.       (kill-buffer (current-buffer))
  2351.       (message "Creating source %s, for index %s...done." source index)
  2352.       ))))
  2353.  
  2354.  
  2355. ;;; a simple way to get into "wais"
  2356.  
  2357. (defun wais ()
  2358.   "Find a wais question and go to it.
  2359. First tries to find the question named Quick, then any wais question,
  2360. finally it creates a Quick question, prompting for search words and source.
  2361. If this is the first time a user tries to use wais, it will create a new
  2362. question name Quick, using the directory-of-servers as a source, and submit
  2363. a '?' for the query."
  2364.   (interactive)
  2365.   (let ((quick-buffer (get-buffer "Quick: Results")))
  2366.     (if quick-buffer
  2367.     (progn
  2368.       (set-buffer quick-buffer)
  2369.       (wais-redisplay-internal))
  2370.      ;;; that means we don't have a quick question around.
  2371.      ;;; let's find what we've got
  2372.     (do* ((buffers (buffer-list) (cdr buffers))
  2373.           (buffer (car buffers) (car buffers))
  2374.           (done nil))
  2375.          ((or (null buffers) done) 
  2376.           (unless done (wais-create-question "Quick")))
  2377.       (set-buffer buffer)
  2378.       (when (and (boundp 'current-question-filename)
  2379.              current-question-filename)
  2380.         (wais-redisplay-internal)
  2381.         (setq done t))))))
  2382.  
  2383. ;;; code to create the question directory if it doesn't exist
  2384.  
  2385. (defun wais-create-directory (directory)
  2386.   "create a directory"
  2387.   (if (string= "/" (substring directory -1))
  2388.       (setq directory (substring directory 0 -1)))
  2389.   (shell-command-fast (concat "/bin/mkdir " directory))
  2390.   (if (null (file-attributes directory))
  2391.       (error "Could not create directory %s" directory)))
  2392.  
  2393. (defun check-init-directories ()
  2394.   (let ((result nil))
  2395.     (if (not (file-attributes *wais-question-directory*))
  2396.     (progn (message "Creating %s" *wais-question-directory*)
  2397.            (wais-create-directory (expand-file-name *wais-question-directory*))
  2398.            (setq result t)))
  2399.     (if (not (file-attributes *wais-source-directory*))
  2400.     (progn (message "Creating %s" *wais-source-directory*)
  2401.            (wais-create-directory (expand-file-name *wais-source-directory*))
  2402.            (setq result t)))
  2403.     (if (not (file-attributes *wais-document-directory*))
  2404.     (progn (message "Creating %s" *wais-document-directory*)
  2405.            (wais-create-directory (expand-file-name *wais-document-directory*))
  2406.            (setq result t)))
  2407.     result))
  2408.